/* Declarations for the cons type.

   This file is part of khipu.

   khipu is free software: you can redistribute it and/or modify
   it under the terms of the GNU Lesser General Public License as published by
   the Free Software Foundation; either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public License
   along with this program.  If not, see <https://www.gnu.org/licenses/>.  */

#ifndef __KP_CONS__
#define __KP_CONS__   1

#include "interp.hpp"
#include "initop.hpp"

KP_DECLS_BEGIN

/* Conses do not possess a header, and pointers to conses are
 * marked specially as well. This means, on the other hand,
 * that they work a bit differently than other objects. */
struct alignas (8) cons
{
  static const int code = typecode::CONS;

  object car;
  object cdr;

  object as_obj () const
    {
#ifdef KP_ARCH_WIDE
      return (ptrtype (this, typecode::CONS));
#else
      return ((object)this | 2);
#endif
    }

  static object make (interpreter *interp, object car, object cdr);

  struct iter_base
    {
      int state = 0;

      inline object _Advance (object& fast, object& slow);
    };

  struct unsafe_iter : public iter_base
    {
      object fast;
      object slow;

      unsafe_iter (object cons) : fast (cons), slow (cons)
        {
        }

      inline bool valid () const;
      inline object& operator* ();
      inline object operator* () const;

      bool circular () const
        {
          return (this->fast == UNBOUND);
        }

      unsafe_iter& operator++ ()
        {
          this->_Advance (this->fast, this->slow);
          return (*this);
        }

      unsafe_iter operator++ (int)
        {
          unsafe_iter rv = *this;
          ++*this;
          return (rv);
        }

      object node () const
        {
          return (this->fast);
        }

      object prev_node () const
        {
          return (this->slow);
        }
    };

  struct safe_iter : public iter_base
    {
      valref_head vh;
      fast_valref fast;
      fast_valref slow;
      fast_valref value;

      inline safe_iter (interpreter *interp, object cons);

      safe_iter (interpreter *interp, const safe_iter& right) :
          vh (interp), fast (interp, *right.fast),
          slow (interp, *right.slow), value (interp, *right.value)
        {
        }

      void reset (const safe_iter& right)
        {
          *this->slow = *right.slow;
          *this->fast = *right.fast;
          *this->value = *right.value;
        }

      inline bool valid () const;
      inline object operator* () const;

      bool circular () const
        {
          return (*this->fast == UNBOUND);
        }

      safe_iter& operator++ ()
        {
          *this->value = this->_Advance (*this->fast, *this->slow);
          return (*this);
        }

      safe_iter operator++ (int)
        {
          safe_iter rv { this->vh.ip, *this };
          ++*this;
          return (rv);
        }

      object node () const
        {
          return (*this->fast);
        }

      object prev_node () const
        {
          return (*this->slow);
        }
    };

  typedef safe_iter iterator;

  // GC-specific methods.
  bool gc_mark ();
  bool old_gen_p () const;
};

static_assert (alignof (cons) % 8 == 0 &&
  sizeof (cons) == 2 * sizeof (object), "invalid alignment/size for conses");

KP_EXPORT const object NIL;

#ifdef KP_ARCH_WIDE

inline constexpr bool xcons_p (object obj)
{
  return (itype (obj) == typecode::CONS);
}

#else

inline constexpr bool xcons_p (object obj)
{
  return ((obj & 3) == 2);
}

#endif

inline bool cons_p (object obj)
{
  return (obj != NIL && xcons_p (obj));
}

inline bool atom_p (object obj)
{
  return (!cons_p (obj));
}

inline cons* as_cons (object obj)
{
  return ((cons *)unmask (obj));
}

// Fast, unsafe access.
inline object& xcar (object obj)
{
  return (as_cons(obj)->car);
}

inline object& xcdr (object obj)
{
  return (as_cons(obj)->cdr);
}

inline object& xcadr (object obj)
{
  return (xcar (xcdr (obj)));
}

inline object& xcddr (object obj)
{
  return (xcdr (xcdr (obj)));
}

object cons::iter_base::_Advance (object& fast, object& slow)
{
  fast = xcdr (fast);

  if (fast == slow)
    fast = UNBOUND;
  else if (this->state == 1)
    slow = xcdr (slow);

  this->state ^= 1;
  return (xcons_p (fast) ? xcar (fast) : UNBOUND);
}

bool cons::unsafe_iter::valid () const
{
  return (cons_p (this->fast));
}

object& cons::unsafe_iter::operator* ()
{
  return (xcar (this->fast));
}

object cons::unsafe_iter::operator* () const
{
  return (xcar (this->fast));
}

object cons::safe_iter::operator* () const
{
  return (xcar (*this->fast));
}

cons::safe_iter::safe_iter (interpreter *interp, object cns) : vh (interp),
  fast (interp, cns), slow (interp, cns), value (interp, xcar (cns))
{
}

bool cons::safe_iter::valid () const
{
  return (cons_p (*this->fast));
}

struct stream;
struct io_info;
struct pack_info;
struct comparator;

// Allocate a single cons.
KP_EXPORT object alloc_cons (interpreter *interp);

// Allocate N conses.
KP_EXPORT object alloc_cons (interpreter *interp, uint32_t n);

// Return the length of the list CONS. Place its tail in DOTC.
KP_EXPORT int32_t len_L (interpreter *interp, object cons, object& dotc);

// Same as above, only it raises an exception if CONS is not a proper list.
KP_EXPORT int32_t len_L (interpreter *interp, object cons);

// Index a list.
KP_EXPORT object get_L (interpreter *interp,
  object cons, object idx, object dfl);

// Get the subsequence of a list.
KP_EXPORT object subseq_L (interpreter *interp,
  object cons, object i1, object i2);

// Destructively set an object inside a list.
KP_EXPORT object nput_L (interpreter *interp,
  object cons, object idx, object val);

// Copy a list.
KP_EXPORT object copy_L (interpreter *interp, object obj, bool deep);

// Concatenate lists L1 and L2.
KP_EXPORT object add_LL (interpreter *interp, object l1, object l2);

// Concate ARGC lists inside ARGV.
KP_EXPORT object concat_L (interpreter *interp, object *argv, int argc);

// Compute the hashcode of a list.
KP_EXPORT uint32_t hash_L (interpreter *interp, object obj);

// Iterator interface for a list.
KP_EXPORT object iter_L (interpreter *interp,
  object obj, object token, bool adv);

// Write a list to a stream.
KP_EXPORT int write_L (interpreter *interp,
  stream *strm, object obj, io_info& info);

// Serialize a list in a stream.
KP_EXPORT int64_t pack_L (interpreter *interp,
  stream *strm, object obj, pack_info& info);

// Deserialize a list from a stream.
KP_EXPORT object unpack_L (interpreter *interp,
  stream *strm, pack_info& info, bool save);

// Reverse a list.
KP_EXPORT object reverse_L (interpreter *interp, object obj);

// Destructively reverse a list.
KP_EXPORT object nreverse_L (interpreter *interp, object obj);

// Sort a list.
KP_EXPORT object sort_L (interpreter *interp, object obj);

// Destructively sort a list.
KP_EXPORT object nsort_L (interpreter *interp, object obj, comparator& c);

// Test for list equality.
KP_EXPORT bool eq_LL (interpreter *interp, object l1, object l2);

// Compare lists L1 and L2.
KP_EXPORT int cmp_LL (interpreter *interp, object l1, object l2);

// Return the IDX'th cdr of list LST.
KP_EXPORT object nthcdr (interpreter *interp, object idx, object lst);

// Get the last cdr of list LST.
KP_EXPORT object last_L (interpreter *interp, object lst);

// Destructively concatenate ARGC lists in ARGV.
KP_EXPORT object nconcat (interpreter *interp, object *argv, int argc);

// Destructively reverse LST and concatenate TAIL into it.
KP_EXPORT object nrevconc (interpreter *interp, object lst, object tail);

// Set the car of LST to OBJ.
KP_EXPORT object nputcar (interpreter *interp, object lst, object obj);

// Set the cdr of LST to OBJ.
KP_EXPORT object nputcdr (interpreter *interp, object lst, object obj);

// Mutate an object inside the list.
KP_EXPORT object nzap_L (interpreter *interp, object obj, object key,
  uint32_t flags, object fn, object *argv, int argc);

// Find an element in a list.
KP_EXPORT object find_L (interpreter *interp, object obj,
  object key, object start, object end, object test);

// Init OP for conses.
KP_EXPORT init_op init_cons;

KP_DECLS_END

#endif
